home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / HFTUBE.ZIP / TUBEPRE.PAS < prev    next >
Pascal/Delphi Source File  |  1995-04-02  |  3KB  |  82 lines
  1. Program TubePre;
  2. {$M 4096,0,0}
  3. Uses Crt;
  4. Var Line,Err:Byte;
  5.     X,Y:LongInt;
  6.     Rm,A:Real;
  7.     Segm,Point,LinePos:Word;
  8.     Rmax:Array[0..519] Of Real;
  9.     LineLen:Array[0..255] Of Byte;
  10.     Fil:File;
  11.     FilT:Text;
  12.  
  13. Procedure WriteH(Val:Byte);
  14. Const HStr:String='0123456789ABCDEF';
  15. Begin
  16.  Write(FilT,'0',HStr[1+Val Shr 4],HStr[1+Val And 15],'h,');
  17. End;
  18.  
  19. Begin
  20.  { allocate required amount of memory }
  21.  Asm Mov   Err,00h
  22.      Mov   Ah,48h
  23.      Mov   Bx,0FA0h
  24.      Int   21h
  25.      Adc   Err,00h
  26.      Mov   Segm,Ax
  27.  End;
  28.  If Err>0 Then Begin WriteLn('Not Enough Memory!!!'); Halt(1); End;
  29.  
  30.  { Calculate radiuses to the specified edge on the screen from the centre }
  31.  Point:=0;
  32.  For Y:=0 to 99 Do Begin Rmax[Point]:=Sqrt(Y*Y+25281); Inc(Point); End;
  33.  For X:=-159 to 0 Do Begin Rmax[Point]:=Sqrt(X*X+9801); Inc(Point); End;
  34.  For X:=0 to 159 Do Begin Rmax[Point]:=Sqrt(X*X+9801); Inc(Point); End;
  35.  For Y:=99 downto 0 Do Begin Rmax[Point]:=Sqrt(Y*Y+25281); Inc(Point); End;
  36.  
  37.  { Calculate each voxel line length and output result to the file }
  38.  Assign(FilT,'POKS'); ReWrite(FilT); Point:=0;
  39.  For X:=0 to 127 Do Begin
  40.   If X=0 Then Rm:=106.96101053 Else If X=127 Then Rm:=66.598365046 Else Begin
  41.     A:=-(Pi/2)*(1-X/127); A:=Sin(A)/Cos(A);
  42.     If A>-1.6060606 Then
  43.      Rm:=0.672710758*Rmax[Round(259+99*A)] Else
  44.      Rm:=0.672710758*Rmax[Round(-159/A)];
  45.    End; WriteH(Round(Rm+1)); LineLen[Point]:=Round(Rm); Inc(Point); End;
  46.  WriteLn(FilT);
  47.  For X:=127 downto 0 Do Begin
  48.   If X=0 Then Rm:=106.96101053 Else If X=127 Then Rm:=66.598365046 Else Begin
  49.     A:=-(Pi/2)*(1-X/127); A:=Sin(A)/Cos(A);
  50.     If A>-1.6060606 Then
  51.      Rm:=0.672710758*Rmax[Round(259+99*A)] Else
  52.      Rm:=0.672710758*Rmax[Round(-159/A)];
  53.    End; WriteH(Round(Rm+1)); LineLen[Point]:=Round(Rm); Inc(Point); End;
  54.  Close(FilT);
  55.  
  56.  { Calculate bitmap pointer table, which will be used to read data from }
  57.  { specified position of bitmap and move it to the screen. Output result }
  58.  { to the file }
  59.  Point:=$F9FE;
  60.  For Y:=99 downto 0 Do Begin
  61.   For X:=-159 to 0 Do Begin
  62.    If X<>0 Then Line:=Round(127*Abs(ArcTan(Y/X))/(Pi/2)) Else Line:=127;
  63.    If Y=0 Then Rm:=159 Else If X=0 Then Rm:=99 Else
  64.      If X/Y>-1.6060606 Then
  65.       Rm:=Rmax[Round(259+99*X/Y)] Else
  66.       Rm:=Rmax[Round(-159*Y/X)];
  67.    LinePos:=Round((LineLen[Line]-1)*(1-Sqrt(X*X+Y*Y)/Rm));
  68.    MemW[Segm:Point]:=LinePos*512+Line;
  69.    Dec(Point,2); End;
  70.   For X:=0 to 159 Do Begin
  71.    If Y<>0 Then Line:=Round(128+127*Abs(ArcTan(X/Y))/(Pi/2)) Else Line:=255;
  72.    If Y=0 Then Rm:=159 Else If X=0 Then Rm:=99 Else
  73.     If X/Y<1.6060606 Then
  74.      Rm:=Rmax[Round(260+159*(X/Y)/1.6060606)] Else
  75.      Rm:=Rmax[Round(420+99*(1-1.6060606*(Y/X)))];
  76.    LinePos:=Round((LineLen[Line]-1)*(1-Sqrt(X*X+Y*Y)/Rm));
  77.    MemW[Segm:Point]:=LinePos*512+Line;
  78.    Dec(Point,2); End; End;
  79.  Assign(Fil,'TUBE.DAT'); ReWrite(Fil,1);
  80.  BlockWrite(Fil,Mem[Segm:0],64000); Close(Fil);
  81. End.
  82.